phynexis-deps/lapack
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'Reference-LAPACK:master' into implement-axpby

Browse Source
This commit is contained in:
Martin Köhler
2025-04-23 21:31:09 +02:00
committed by GitHub
parent 1221bb2595 72df25ba80
commit 506f2b3541
2069 changed files with 4540 additions and 6218 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.github/workflows/cmake.yml
+4 -4
View File
@@ -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
fi
.github/workflows/makefile.yml
+2 -2
View File
@@ -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
.github/workflows/scorecard.yml
+4 -4
View File
@@ -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
.gitignore
+4
View File
@@ -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
BLAS/SRC/cgemmtr.f
+3 -3
View File
@@ -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
BLAS/SRC/dgemmtr.f
+3 -3
View File
@@ -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
BLAS/SRC/drotm.f
+4
View File
@@ -38,6 +38,10 @@
*> H=( ) ( ) ( ) ( )
*> (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0).
*> SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM.
*>
*> IF DFLAG IS NOT ONE OF THE LISTED ABOVE, THE BEHAVIOR IS UNDEFINED.
*> NANS IN DFLAG MAY NOT PROPAGATE TO THE OUTPUT.
*>
*> \endverbatim
*
* Arguments:
BLAS/SRC/sgemmtr.f
+3 -3
View File
@@ -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
BLAS/SRC/srotm.f
+3
View File
@@ -39,6 +39,9 @@
*> (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0).
*> SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM.
*>
*> IF SFLAG IS NOT ONE OF THE LISTED ABOVE, THE BEHAVIOR IS UNDEFINED.
*> NANS IN SFLAG MAY NOT PROPAGATE TO THE OUTPUT.
*>
*> \endverbatim
*
* Arguments:
BLAS/SRC/zgemmtr.f
+3 -3
View File
@@ -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
BLAS/TESTING/cblat3.f
+40 -37
View File
@@ -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 10 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 23 lines:
*> 'cblat3.out' NAME OF SUMMARY OUTPUT FILE
@@ -389,7 +389,7 @@
$ 7( '(', F4.1, ',', F4.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 CMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU',
$ 'ATED WRONGLY.', /' CMMCH WAS CALLED WITH TRANSA = ', A1,
@@ -674,15 +674,15 @@
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, ',', F4.1, '), A,', I3, ', B,', I3,
$ ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -953,15 +953,15 @@
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, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
$ ',', F4.1, '), C,', I3, ') .' )
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -1263,15 +1263,15 @@
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, ',', F4.1, '), A,', I3, ', B,', I3, ') ',
$ ' .' )
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -1591,19 +1591,19 @@
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( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
9993 FORMAT( 1X, I6, ': ', A7, '(', 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 *',
@@ -1964,19 +1964,19 @@
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, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1,
$ ', C,', I3, ') .' )
9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
9993 FORMAT( 1X, I6, ': ', A7, '(', 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 *',
@@ -2019,7 +2019,7 @@
COMPLEX A( 2, 1 ), B( 2, 1 ), C( 2, 1 )
* .. External Subroutines ..
EXTERNAL CGEMM, CHEMM, CHER2K, CHERK, CHKXER, CSYMM,
$ CSYR2K, CSYRK, CTRMM, CTRSM
$ CSYR2K, CSYRK, CTRMM, CTRSM, CGEMMTR
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK, LERR
* .. Executable Statements ..
@@ -3115,8 +3115,8 @@
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 CCHKE
@@ -3629,7 +3629,7 @@
RETURN
*
9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D',
$ 'ETECTED BY ', A6, ' *****' )
$ 'ETECTED BY ', A7, ' *****' )
*
* End of CHKXER
*
@@ -3663,6 +3663,8 @@
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUT, OK, LERR
COMMON /SRNAMC/SRNAMT
* .. Locals ..
INTEGER SRLEN
* .. Executable Statements ..
LERR = .TRUE.
IF( INFO.NE.INFOT )THEN
@@ -3673,7 +3675,8 @@
END IF
OK = .FALSE.
END IF
IF( SRNAME.NE.SRNAMT )THEN
SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT))
IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN
WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
OK = .FALSE.
END IF
@@ -3681,8 +3684,8 @@
*
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,
$ ' *******' )
*
@@ -3738,7 +3741,7 @@
LOGICAL LCE, LCERES
EXTERNAL LCE, LCERES
* .. External Subroutines ..
EXTERNAL CGEMM, CMAKE, CMMCH
EXTERNAL CGEMMTR, CMAKE, CMMTCH
* .. Intrinsic Functions ..
INTRINSIC MAX
* .. Scalars in Common ..
@@ -3956,21 +3959,21 @@
*
120 CONTINUE
WRITE( NOUT, FMT = 9996 )SNAME
WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, N, K,
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',
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, ',', F4.1, '), A,', I3, ', B,', I3,
$ ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
BLAS/TESTING/dblat3.f
+37 -33
View File
@@ -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 21 lines:
*> 'dblat3.out' NAME OF SUMMARY OUTPUT FILE
@@ -122,6 +122,7 @@
EXTERNAL DDIFF, LDE
* .. External Subroutines ..
EXTERNAL DCHK1, DCHK2, DCHK3, DCHK4, DCHK5, DCHKE, DMMCH
EXTERNAL DCHK6
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
* .. Scalars in Common ..
@@ -379,7 +380,7 @@
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 DMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU',
$ 'ATED WRONGLY.', /' DMMCH WAS CALLED WITH TRANSA = ', A1,
@@ -660,15 +661,15 @@
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 *',
@@ -930,15 +931,15 @@
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 *',
@@ -1236,15 +1237,15 @@
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 *',
$ '******' )
@@ -1510,16 +1511,16 @@
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 *',
$ '******' )
@@ -1823,16 +1824,16 @@
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 *',
@@ -1873,7 +1874,7 @@
DOUBLE PRECISION A( 2, 1 ), B( 2, 1 ), C( 2, 1 )
* .. External Subroutines ..
EXTERNAL CHKXER, DGEMM, DSYMM, DSYR2K, DSYRK, DTRMM,
$ DTRSM
$ DTRSM, DGEMMTR
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK, LERR
* .. Executable Statements ..
@@ -2468,8 +2469,8 @@
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 DCHKE
@@ -2893,7 +2894,7 @@
RETURN
*
9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D',
$ 'ETECTED BY ', A6, ' *****' )
$ 'ETECTED BY ', A7, ' *****' )
*
* End of CHKXER
*
@@ -2927,6 +2928,8 @@
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUT, OK, LERR
COMMON /SRNAMC/SRNAMT
* .. Locals ..
INTEGER SRLEN
* .. Executable Statements ..
LERR = .TRUE.
IF( INFO.NE.INFOT )THEN
@@ -2937,7 +2940,8 @@
END IF
OK = .FALSE.
END IF
IF( SRNAME.NE.SRNAMT )THEN
SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT))
IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN
WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
OK = .FALSE.
END IF
@@ -2945,8 +2949,8 @@
*
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,
$ ' *******' )
*
@@ -3221,15 +3225,15 @@
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 *',
BLAS/TESTING/sblat3.f
+6 -2
View File
@@ -122,6 +122,7 @@
EXTERNAL SDIFF, LSE
* .. External Subroutines ..
EXTERNAL SCHK1, SCHK2, SCHK3, SCHK4, SCHK5, SCHKE, SMMCH
EXTERNAL SCHK6
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
* .. Scalars in Common ..
@@ -2927,6 +2928,8 @@
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUT, OK, LERR
COMMON /SRNAMC/SRNAMT
* .. Locals ..
INTEGER SRLEN
* .. Executable Statements ..
LERR = .TRUE.
IF( INFO.NE.INFOT )THEN
@@ -2937,7 +2940,8 @@
END IF
OK = .FALSE.
END IF
IF( SRNAME .NE. SRNAME ) THEN
SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT))
IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN
WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
OK = .FALSE.
END IF
@@ -2996,7 +3000,7 @@
LOGICAL LSE, LSERES
EXTERNAL LSE, LSERES
* .. External Subroutines ..
EXTERNAL SGEMMTR, DMAKE, DMMTCH
EXTERNAL SGEMMTR, SMAKE, SMMTCH
* .. Intrinsic Functions ..
INTRINSIC MAX
* .. Scalars in Common ..
BLAS/TESTING/zblat3.f
+40 -37
View File
@@ -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 10 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 23 lines:
*> 'zblat3.out' NAME OF SUMMARY OUTPUT FILE
@@ -393,7 +393,7 @@
$ 7( '(', F4.1, ',', F4.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 ZMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU',
$ 'ATED WRONGLY.', /' ZMMCH WAS CALLED WITH TRANSA = ', A1,
@@ -678,15 +678,15 @@
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, ',', F4.1, '), A,', I3, ', B,', I3,
$ ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -957,15 +957,15 @@
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, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
$ ',', F4.1, '), C,', I3, ') .' )
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -1268,15 +1268,15 @@
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, ',', F4.1, '), A,', I3, ', B,', I3, ') ',
$ ' .' )
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -1596,19 +1596,19 @@
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( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
9993 FORMAT( 1X, I6, ': ', A7, '(', 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 *',
@@ -1970,19 +1970,19 @@
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, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1,
$ ', C,', I3, ') .' )
9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
9993 FORMAT( 1X, I6, ': ', A7, '(', 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 *',
@@ -2026,7 +2026,7 @@
COMPLEX*16 A( 2, 1 ), B( 2, 1 ), C( 2, 1 )
* .. External Subroutines ..
EXTERNAL ZGEMM, ZHEMM, ZHER2K, ZHERK, CHKXER, ZSYMM,
$ ZSYR2K, ZSYRK, ZTRMM, ZTRSM
$ ZSYR2K, ZSYRK, ZTRMM, ZTRSM, ZGEMMTR
* .. Intrinsic Functions ..
INTRINSIC DCMPLX
* .. Common blocks ..
@@ -3124,8 +3124,8 @@
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 ZCHKE
@@ -3641,7 +3641,7 @@
RETURN
*
9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D',
$ 'ETECTED BY ', A6, ' *****' )
$ 'ETECTED BY ', A7, ' *****' )
*
* End of CHKXER
*
@@ -3675,6 +3675,8 @@
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUT, OK, LERR
COMMON /SRNAMC/SRNAMT
* .. Locals ..
INTEGER SRLEN
* .. Executable Statements ..
LERR = .TRUE.
IF( INFO.NE.INFOT )THEN
@@ -3685,7 +3687,8 @@
END IF
OK = .FALSE.
END IF
IF( SRNAME.NE.SRNAMT )THEN
SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT))
IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN
WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
OK = .FALSE.
END IF
@@ -3693,8 +3696,8 @@
*
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,
$ ' *******' )
*
@@ -3752,7 +3755,7 @@
LOGICAL LZE, LZERES
EXTERNAL LZE, LZERES
* .. External Subroutines ..
EXTERNAL CGEMM, ZMAKE, CMMCH
EXTERNAL ZGEMMTR, ZMAKE, ZMMTCH
* .. Intrinsic Functions ..
INTRINSIC MAX
* .. Scalars in Common ..
@@ -3970,21 +3973,21 @@
*
120 CONTINUE
WRITE( NOUT, FMT = 9996 )SNAME
WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, N, K,
WRITE( NOUT, FMT = 9995 )NC, UPLO, SNAME, TRANSA, TRANSB, N, K,
$ ALPHA, LDA, LDB, BETA, LDC
*
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, ',', F4.1, '), A,', I3, ', B,', I3,
$ ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
CMakeLists.txt
+1 -1
View File
@@ -4,7 +4,7 @@ project(LAPACK C)
set(LAPACK_MAJOR_VERSION 3)
set(LAPACK_MINOR_VERSION 12)
set(LAPACK_PATCH_VERSION 0)
set(LAPACK_PATCH_VERSION 1)
set(
LAPACK_VERSION
${LAPACK_MAJOR_VERSION}.${LAPACK_MINOR_VERSION}.${LAPACK_PATCH_VERSION}
DOCS/Doxyfile
+688 -385
View File
File diff suppressed because it is too large Load Diff
DOCS/DoxygenLayout.xml
+84 -9
View File
@@ -1,23 +1,44 @@
<?xml version="1.0" encoding="UTF-8"?>
<doxygenlayout version="1.0">
<!-- Generated by doxygen 1.8.13 -->
<!-- Generated by doxygen 1.12.0 -->
<!-- Navigation index tabs for HTML output -->
<navindex>
<tab type="mainpage" visible="yes" title=""/>
<tab type="pages" visible="yes" title="" intro=""/>
<!-- LAPACK: change "Modules" to "Routines" -->
<tab type="modules" visible="yes" title="Routines" intro=""/>
<!-- LAPACK: change "Topics" to "Routines" -->
<tab type="topics" visible="yes" title="Routines" intro=""/>
<tab type="modules" visible="yes" title="" intro="">
<tab type="modulelist" visible="yes" title="" intro=""/>
<tab type="modulemembers" visible="yes" title="" intro=""/>
</tab>
<tab type="namespaces" visible="yes" title="">
<tab type="namespacelist" visible="yes" title="" intro=""/>
<tab type="namespacemembers" visible="yes" title="" intro=""/>
</tab>
<tab type="concepts" visible="yes" title="">
</tab>
<tab type="interfaces" visible="yes" title="">
<tab type="interfacelist" visible="yes" title="" intro=""/>
<tab type="interfaceindex" visible="$ALPHABETICAL_INDEX" title=""/>
<tab type="interfacehierarchy" visible="yes" title="" intro=""/>
</tab>
<tab type="classes" visible="yes" title="">
<tab type="classlist" visible="yes" title="" intro=""/>
<tab type="classindex" visible="$ALPHABETICAL_INDEX" title=""/>
<tab type="hierarchy" visible="yes" title="" intro=""/>
<tab type="classmembers" visible="yes" title="" intro=""/>
</tab>
<tab type="structs" visible="yes" title="">
<tab type="structlist" visible="yes" title="" intro=""/>
<tab type="structindex" visible="$ALPHABETICAL_INDEX" title=""/>
</tab>
<tab type="exceptions" visible="yes" title="">
<tab type="exceptionlist" visible="yes" title="" intro=""/>
<tab type="exceptionindex" visible="$ALPHABETICAL_INDEX" title=""/>
<tab type="exceptionhierarchy" visible="yes" title="" intro=""/>
</tab>
<tab type="files" visible="yes" title="">
<tab type="filelist" visible="yes" title="" intro=""/>
<tab type="globals" visible="yes" title="" intro=""/>
@@ -28,9 +49,9 @@
<!-- Layout definition for a class page -->
<class>
<briefdescription visible="yes"/>
<includes visible="$SHOW_INCLUDE_FILES"/>
<inheritancegraph visible="$CLASS_GRAPH"/>
<collaborationgraph visible="$COLLABORATION_GRAPH"/>
<includes visible="$SHOW_HEADERFILE"/>
<inheritancegraph visible="yes"/>
<collaborationgraph visible="yes"/>
<memberdecl>
<nestedclasses visible="yes" title=""/>
<publictypes title=""/>
@@ -90,40 +111,66 @@
<memberdecl>
<nestednamespaces visible="yes" title=""/>
<constantgroups visible="yes" title=""/>
<interfaces visible="yes" title=""/>
<classes visible="yes" title=""/>
<concepts visible="yes" title=""/>
<structs visible="yes" title=""/>
<exceptions visible="yes" title=""/>
<typedefs title=""/>
<sequences title=""/>
<dictionaries title=""/>
<enums title=""/>
<functions title=""/>
<variables title=""/>
<properties title=""/>
<membergroups visible="yes"/>
</memberdecl>
<detaileddescription title=""/>
<memberdef>
<inlineclasses title=""/>
<typedefs title=""/>
<sequences title=""/>
<dictionaries title=""/>
<enums title=""/>
<functions title=""/>
<variables title=""/>
<properties title=""/>
</memberdef>
<authorsection visible="yes"/>
</namespace>
<!-- Layout definition for a concept page -->
<concept>
<briefdescription visible="yes"/>
<includes visible="$SHOW_HEADERFILE"/>
<definition visible="yes" title=""/>
<detaileddescription title=""/>
<authorsection visible="yes"/>
</concept>
<!-- Layout definition for a file page -->
<file>
<briefdescription visible="yes"/>
<includes visible="$SHOW_INCLUDE_FILES"/>
<includegraph visible="$INCLUDE_GRAPH"/>
<includedbygraph visible="$INCLUDED_BY_GRAPH"/>
<includegraph visible="yes"/>
<includedbygraph visible="yes"/>
<sourcelink visible="yes"/>
<memberdecl>
<interfaces visible="yes" title=""/>
<classes visible="yes" title=""/>
<structs visible="yes" title=""/>
<exceptions visible="yes" title=""/>
<namespaces visible="yes" title=""/>
<concepts visible="yes" title=""/>
<constantgroups visible="yes" title=""/>
<defines title=""/>
<typedefs title=""/>
<sequences title=""/>
<dictionaries title=""/>
<enums title=""/>
<functions title=""/>
<variables title=""/>
<properties title=""/>
<membergroups visible="yes"/>
</memberdecl>
<detaileddescription title=""/>
@@ -131,9 +178,12 @@
<inlineclasses title=""/>
<defines title=""/>
<typedefs title=""/>
<sequences title=""/>
<dictionaries title=""/>
<enums title=""/>
<functions title=""/>
<variables title=""/>
<properties title=""/>
</memberdef>
<authorsection/>
</file>
@@ -141,15 +191,19 @@
<!-- Layout definition for a group page -->
<group>
<briefdescription visible="yes"/>
<groupgraph visible="$GROUP_GRAPHS"/>
<groupgraph visible="yes"/>
<memberdecl>
<nestedgroups visible="yes" title=""/>
<modules visible="yes" title=""/>
<dirs visible="yes" title=""/>
<files visible="yes" title=""/>
<namespaces visible="yes" title=""/>
<concepts visible="yes" title=""/>
<classes visible="yes" title=""/>
<defines title=""/>
<typedefs title=""/>
<sequences title=""/>
<dictionaries title=""/>
<enums title=""/>
<enumvalues title=""/>
<functions title=""/>
@@ -169,6 +223,8 @@
<inlineclasses title=""/>
<defines title=""/>
<typedefs title=""/>
<sequences title=""/>
<dictionaries title=""/>
<enums title=""/>
<enumvalues title=""/>
<functions title=""/>
@@ -184,6 +240,25 @@
<authorsection visible="yes"/>
</group>
<!-- Layout definition for a C++20 module page -->
<module>
<briefdescription visible="yes"/>
<exportedmodules visible="yes"/>
<memberdecl>
<concepts visible="yes" title=""/>
<classes visible="yes" title=""/>
<enums title=""/>
<typedefs title=""/>
<functions title=""/>
<variables title=""/>
<membergroups title=""/>
</memberdecl>
<detaileddescription title=""/>
<memberdecl>
<files visible="yes"/>
</memberdecl>
</module>
<!-- Layout definition for a directory page -->
<directory>
<briefdescription visible="yes"/>
DOCS/groups-usr.dox
-1
View File
@@ -964,7 +964,6 @@ https://www.netlib.org/xblas/
@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
@defgroup her2k {he,sy}r2k: Hermitian/symmetric rank-2k update
INSTALL/ilaver.f
+1 -1
View File
@@ -59,7 +59,7 @@
* =====================================================================
VERS_MAJOR = 3
VERS_MINOR = 12
VERS_PATCH = 0
VERS_PATCH = 1
* =====================================================================
*
RETURN
LAPACKE/src/lapacke_ctfsm.c
+1 -1
View File
@@ -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 ) ) {
LAPACKE/src/lapacke_ctfsm_work.c
+1 -1
View File
@@ -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;
LAPACKE/src/lapacke_ctpmqrt_work.c
+2 -2
View File
@@ -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 );
LAPACKE/src/lapacke_dtfsm.c
+1 -1
View File
@@ -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;
LAPACKE/src/lapacke_dtfsm_work.c
+1 -1
View File
@@ -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;
LAPACKE/src/lapacke_dtpmqrt_work.c
+2 -2
View File
@@ -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 );
LAPACKE/src/lapacke_nancheck.c
+1 -1
View File
@@ -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;
LAPACKE/src/lapacke_stfsm.c
+1 -1
View File
@@ -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 ) ) {
LAPACKE/src/lapacke_stfsm_work.c
+1 -1
View File
@@ -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;
LAPACKE/src/lapacke_stpmqrt_work.c
+2 -2
View File
@@ -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 );
LAPACKE/src/lapacke_ztfsm.c
+1 -1
View File
@@ -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 ) ) {
LAPACKE/src/lapacke_ztfsm_work.c
+2 -2
View File
@@ -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 );
LAPACKE/src/lapacke_ztpmqrt_work.c
+2 -2
View File
@@ -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 );
LICENSE
+3 -3
View File
@@ -1,9 +1,9 @@
Copyright (c) 1992-2023 The University of Tennessee and The University
Copyright (c) 1992-2025 The University of Tennessee and The University
of Tennessee Research Foundation. All rights
reserved.
Copyright (c) 2000-2023 The University of California Berkeley. All
Copyright (c) 2000-2025 The University of California Berkeley. All
rights reserved.
Copyright (c) 2006-2023 The University of Colorado Denver. All rights
Copyright (c) 2006-2025 The University of Colorado Denver. All rights
reserved.
$COPYRIGHT$
README.md
+3 -2
View File
@@ -38,6 +38,7 @@
* VERSION 3.10.1 : April 2022
* VERSION 3.11.0 : November 2022
* VERSION 3.12.0 : November 2023
* VERSION 3.12.1 : January 2025
LAPACK is a library of Fortran subroutines for solving the most commonly
occurring problems in numerical linear algebra.
@@ -107,8 +108,8 @@ Please see as well the [GitHub issue tracker](https://github.com/Reference-LAPAC
For further information on LAPACK please read our [FAQ](http://www.netlib.org/lapack/faq.html)
and [Users' Guide](http://www.netlib.org/lapack/lug/lapack_lug.html).
A [user forum](http://icl.cs.utk.edu/lapack-forum/) and specific information for
[running LAPACK under Windows](http://icl.cs.utk.edu/lapack-for-windows/lapack/).
is also available to help you with the LAPACK library.
[running LAPACK under Windows](http://icl.cs.utk.edu/lapack-for-windows/lapack/)
are also available to help you with the LAPACK library.
## Testing
SRC/DEPRECATED/cgegs.f
+15 -11
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGEGS + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgegs.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgegs.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -219,9 +217,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 +358,8 @@
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 +379,8 @@
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 +493,14 @@
* 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 +508,14 @@
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
SRC/DEPRECATED/cgegv.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGEGV + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgegv.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgegv.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/DEPRECATED/cgelsx.f
+16 -12
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGELSX + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgelsx.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgelsx.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -179,8 +177,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, --
@@ -294,13 +292,15 @@
*
* 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
*
@@ -362,8 +362,8 @@
*
* B(1:M,1:NRHS) := Q**H * B(1:M,1:NRHS)
*
CALL CUNM2R( 'Left', 'Conjugate transpose', M, NRHS, MN, A, LDA,
$ WORK( 1 ), B, LDB, WORK( 2*MN+1 ), INFO )
CALL CUNM2R( 'Left', 'Conjugate transpose', M, NRHS, MN, A,
$ LDA, WORK( 1 ), B, LDB, WORK( 2*MN+1 ), INFO )
*
* workspace NRHS
*
@@ -420,18 +420,22 @@
* 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
SRC/DEPRECATED/cgeqpf.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGEQPF + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgeqpf.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgeqpf.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/DEPRECATED/cggsvd.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGGSVD + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cggsvd.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cggsvd.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/DEPRECATED/cggsvp.f
+16 -15
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGGSVP + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cggsvp.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cggsvp.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -382,7 +380,8 @@
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
*
@@ -400,8 +399,8 @@
*
* 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
@@ -444,8 +443,9 @@
*
* 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 +453,8 @@
*
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 +474,8 @@
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
*
@@ -486,8 +487,8 @@
*
* 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
@@ -511,9 +512,9 @@
*
* 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
SRC/DEPRECATED/clahrd.f
+11 -12
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CLAHRD + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clahrd.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clahrd.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -236,13 +234,14 @@
*
* 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 +262,20 @@
*
* 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
SRC/DEPRECATED/clatzm.f
+4 -5
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CLATZM + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clatzm.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clatzm.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -148,7 +146,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 +205,8 @@
* 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]
*
SRC/DEPRECATED/ctzrqf.f
+5 -6
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CTZRQF + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ctzrqf.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ctzrqf.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -217,14 +215,15 @@
*
* 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
SRC/DEPRECATED/dgegs.f
+10 -7
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DGEGS + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgegs.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgegs.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -358,7 +356,8 @@
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 +377,8 @@
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 +496,8 @@
* 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 +517,14 @@
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
SRC/DEPRECATED/dgegv.f
+3 -4
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DGEGV + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgegv.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgegv.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -301,8 +299,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, --
SRC/DEPRECATED/dgelqs.f
+6 -5
View File
@@ -174,18 +174,19 @@
*
* 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
*
SRC/DEPRECATED/dgelsx.f
+18 -13
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DGELSX + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgelsx.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgelsx.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -173,8 +171,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 +281,23 @@
*
* 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 +351,8 @@
*
* 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 +409,22 @@
* 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
SRC/DEPRECATED/dgeqpf.f
+6 -7
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DGEQPF + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeqpf.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeqpf.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -218,8 +216,8 @@
MA = MIN( ITEMP, M )
CALL DGEQR2( M, MA, A, LDA, TAU, WORK, INFO )
IF( MA.LT.N ) THEN
CALL DORM2R( 'Left', 'Transpose', M, N-MA, MA, A, LDA, TAU,
$ A( 1, MA+1 ), LDA, WORK, INFO )
CALL DORM2R( 'Left', 'Transpose', M, N-MA, MA, A, LDA,
$ TAU, A( 1, MA+1 ), LDA, WORK, INFO )
END IF
END IF
*
@@ -253,7 +251,8 @@
* 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 +263,8 @@
*
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
*
SRC/DEPRECATED/dggsvd.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DGGSVD + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dggsvd.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dggsvd.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/DEPRECATED/dggsvp.f
+13 -13
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DGGSVP + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dggsvp.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dggsvp.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -392,8 +390,8 @@
*
* 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 +437,10 @@
*
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 +459,8 @@
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 +472,8 @@
*
* 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 +497,9 @@
*
* 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
SRC/DEPRECATED/dlahrd.f
+15 -16
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DLAHRD + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlahrd.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlahrd.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -221,8 +219,8 @@
* 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
*
@@ -231,13 +229,14 @@
*
* w := T**T *w
*
CALL DTRMV( 'Upper', 'Transpose', 'Non-unit', I-1, T, LDT,
$ T( 1, NB ), 1 )
CALL DTRMV( 'Upper', 'Transpose', 'Non-unit', I-1,
$ T, LDT, T( 1, NB ), 1 )
*
* 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,19 +257,19 @@
*
* 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)
*
CALL DSCAL( I-1, -TAU( I ), T( 1, I ), 1 )
CALL DTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, LDT,
$ T( 1, I ), 1 )
CALL DTRMV( 'Upper', 'No transpose', 'Non-unit', I-1,
$ T, LDT, T( 1, I ), 1 )
T( I, I ) = TAU( I )
*
10 CONTINUE
SRC/DEPRECATED/dlatzm.f
+4 -5
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DLATZM + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlatzm.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlatzm.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -147,7 +145,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 +201,8 @@
* 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]
*
SRC/DEPRECATED/dtzrqf.f
+4 -5
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DTZRQF + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtzrqf.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtzrqf.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -194,7 +192,8 @@
* 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 +215,8 @@
* 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
SRC/DEPRECATED/sgegs.f
+10 -7
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download SGEGS + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgegs.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgegs.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -358,7 +356,8 @@
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 +377,8 @@
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 +496,8 @@
* 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 +517,14 @@
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
SRC/DEPRECATED/sgegv.f
+3 -4
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download SGEGV + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgegv.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgegv.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -301,8 +299,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, --
SRC/DEPRECATED/sgelqs.f
+6 -5
View File
@@ -174,18 +174,19 @@
*
* 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
*
SRC/DEPRECATED/sgelsx.f
+20 -15
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download SGELSX + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgelsx.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgelsx.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -173,8 +171,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 +281,23 @@
*
* 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 +351,15 @@
*
* 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 +409,22 @@
* 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
SRC/DEPRECATED/sgeqpf.f
+6 -7
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download SGEQPF + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeqpf.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeqpf.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -218,8 +216,8 @@
MA = MIN( ITEMP, M )
CALL SGEQR2( M, MA, A, LDA, TAU, WORK, INFO )
IF( MA.LT.N ) THEN
CALL SORM2R( 'Left', 'Transpose', M, N-MA, MA, A, LDA, TAU,
$ A( 1, MA+1 ), LDA, WORK, INFO )
CALL SORM2R( 'Left', 'Transpose', M, N-MA, MA, A, LDA,
$ TAU, A( 1, MA+1 ), LDA, WORK, INFO )
END IF
END IF
*
@@ -253,7 +251,8 @@
* 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 +263,8 @@
*
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
*
SRC/DEPRECATED/sggsvd.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download SGGSVD + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sggsvd.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sggsvd.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/DEPRECATED/sggsvp.f
+11 -12
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download SGGSVP + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sggsvp.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sggsvp.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -392,8 +390,8 @@
*
* 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 +437,8 @@
*
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 +458,8 @@
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 +471,8 @@
*
* 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 +496,9 @@
*
* 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
SRC/DEPRECATED/slahrd.f
+17 -18
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download SLAHRD + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slahrd.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slahrd.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -221,8 +219,8 @@
* 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 +229,14 @@
*
* 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 +250,26 @@
* 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
SRC/DEPRECATED/slatzm.f
+4 -5
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download SLATZM + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slatzm.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slatzm.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -147,7 +145,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 +201,8 @@
* 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]
*
SRC/DEPRECATED/stzrqf.f
+4 -5
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download STZRQF + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stzrqf.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stzrqf.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -194,7 +192,8 @@
* 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 +215,8 @@
* 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
SRC/DEPRECATED/zgegs.f
+15 -11
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZGEGS + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgegs.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgegs.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -219,9 +217,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 +358,8 @@
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 +379,8 @@
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 +493,14 @@
* 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 +508,14 @@
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
SRC/DEPRECATED/zgegv.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZGEGV + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgegv.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgegv.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/DEPRECATED/zgelsx.f
+20 -16
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZGELSX + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgelsx.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgelsx.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -179,8 +177,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 +292,23 @@
*
* 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 +362,8 @@
*
* 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 +382,8 @@
*
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 +420,22 @@
* 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
SRC/DEPRECATED/zgeqpf.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZGEQPF + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgeqpf.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgeqpf.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/DEPRECATED/zggsvd.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZGGSVD + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zggsvd.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zggsvd.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/DEPRECATED/zggsvp.f
+18 -16
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZGGSVP + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zggsvp.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zggsvp.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -385,7 +383,8 @@
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 +402,8 @@
*
* 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 +446,9 @@
*
* 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 +456,10 @@
*
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 +478,8 @@
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 +491,8 @@
*
* 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 +516,9 @@
*
* 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
SRC/DEPRECATED/zlahrd.f
+11 -12
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZLAHRD + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlahrd.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlahrd.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -236,13 +234,14 @@
*
* 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 +262,20 @@
*
* 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
SRC/DEPRECATED/zlatzm.f
+4 -5
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZLATZM + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlatzm.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlatzm.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -148,7 +146,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 +205,8 @@
* 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]
*
SRC/DEPRECATED/ztzrqf.f
+5 -6
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZTZRQF + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztzrqf.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztzrqf.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -217,14 +215,15 @@
*
* 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
SRC/VARIANTS/Makefile
+8 -2
View File
@@ -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
SRC/VARIANTS/README
+2
View File
@@ -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
===========
SRC/VARIANTS/larft/LL-LVL2/clarft.f
+326
View File
@@ -0,0 +1,326 @@
*> \brief \b CLARFT VARIANT: left-looking Level 2 BLAS version of the algorithm
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> Download CLARFT + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clarft.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clarft.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clarft.f">
*> [TXT]</a>
*
* 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
SRC/VARIANTS/larft/LL-LVL2/dlarft.f
+324
View File
@@ -0,0 +1,324 @@
*> \brief \b DLARFT VARIANT: left-looking Level 2 BLAS version of the algorithm
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> Download DLARFT + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarft.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarft.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarft.f">
*> [TXT]</a>
*
* 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
SRC/VARIANTS/larft/LL-LVL2/slarft.f
+324
View File
@@ -0,0 +1,324 @@
*> \brief \b SLARFT VARIANT: left-looking Level 2 BLAS version of the algorithm.
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> Download SLARFT + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarft.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarft.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarft.f">
*> [TXT]</a>
*
* 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
SRC/VARIANTS/larft/LL-LVL2/zlarft.f
+325
View File
@@ -0,0 +1,325 @@
*> \brief \b ZLARFT VARIANT: left-looking Level 2 BLAS version of the algorithm.
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> Download ZLARFT + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarft.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarft.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarft.f">
*> [TXT]</a>
*
* 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
SRC/cbbcsd.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CBBCSD + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cbbcsd.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cbbcsd.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cbdsqr.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CBDSQR + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cbdsqr.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cbdsqr.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgbbrd.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGBBRD + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbbrd.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbbrd.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgbcon.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGBCON + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbcon.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbcon.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgbequ.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGBEQU + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbequ.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbequ.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgbequb.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGBEQUB + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbequb.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbequb.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgbrfs.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGBRFS + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbrfs.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbrfs.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgbrfsx.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGBRFSX + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbrfsx.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbrfsx.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgbsv.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGBSV + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbsv.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbsv.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgbsvx.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGBSVX + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbsvx.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbsvx.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgbsvxx.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGBSVXX + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbsvxx.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbsvxx.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgbtf2.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGBTF2 + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbtf2.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbtf2.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgbtrf.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGBTRF + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbtrf.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbtrf.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgbtrs.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGBTRS + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbtrs.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbtrs.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgebak.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGEBAK + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgebak.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgebak.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgebal.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGEBAL + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgebal.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgebal.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgebd2.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGEBD2 + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgebd2.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgebd2.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgebrd.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGEBRD + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgebrd.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgebrd.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgecon.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGECON + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgecon.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgecon.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgeequ.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGEEQU + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgeequ.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgeequ.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgeequb.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGEEQUB + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgeequb.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgeequb.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
SRC/cgees.f
-2
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGEES + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgees.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgees.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========

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